home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / tool_inc.zip / DAYSBFOR.INC < prev    next >
Text File  |  1989-12-31  |  1KB  |  63 lines
  1.  
  2. (* --------------------------------------------------------- *)
  3. procedure itoa2(i: integer; var sp);
  4. var
  5.    s: array[1..2] of char absolute sp;
  6. begin
  7.    s[1] := chr( (i div 10) + ord('0'));
  8.    s[2] := chr( (i mod 10) + ord('0'));
  9. end;
  10.  
  11.  
  12. (* --------------------------------------------------------- *)
  13. procedure determine_first_date(days: integer);
  14.    (* determine first_date as n days before today *)
  15. var
  16.    year:    word;
  17.    month:   word;
  18.    day:     word;
  19.    dow:     word;
  20.  
  21. const
  22.    monthdays:  array[1..12] of integer =
  23.       (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  24.  
  25. begin
  26.    { get today's date from DOS }
  27.    GetDate(year,month,day,dow);
  28.    year := year - 1900;
  29.  
  30.    { backup N days }
  31.    while (days > 0) do
  32.    begin
  33.       dec(days);
  34.  
  35.       if (day > 1) then
  36.          dec(day)
  37.       else
  38.  
  39.       if (month > 1) then
  40.       begin
  41.          dec(month);
  42.          day := monthdays[month];
  43.       end
  44.       else
  45.  
  46.       begin
  47.          dec(year);
  48.          month := 12;
  49.          day := monthdays[month];
  50.       end;
  51.    end;
  52.  
  53.    { format the date for comparison }
  54.    itoa2(year,firstdate[1]);
  55.    itoa2(month,firstdate[3]);
  56.    itoa2(day,firstdate[5]);
  57.  
  58.    writeln('Skipping all messages before ',month,'-',day,'-',year);
  59. end;
  60.  
  61.  
  62.  
  63.